﻿<%
'''SHA1加密类
Class Sha1Class
	'编码
	Public CharSet
	Private s_lOnBits(30)     
	Private s_l2Power(30)     
	Private s_key(63)
	
	'''构造
	Private Sub Class_Initialize()
		CharSet = "UTF-8"
		
		s_lOnBits(0)   =   CLng(1)     
s_lOnBits(1)   =   CLng(3)     
s_lOnBits(2)   =   CLng(7)     
s_lOnBits(3)   =   CLng(15)     
s_lOnBits(4)   =   CLng(31)     
s_lOnBits(5)   =   CLng(63)     
s_lOnBits(6)   =   CLng(127)     
s_lOnBits(7)   =   CLng(255)     
s_lOnBits(8)   =   CLng(511)     
s_lOnBits(9)   =   CLng(1023)     
s_lOnBits(10)   =   CLng(2047)     
s_lOnBits(11)   =   CLng(4095)     
s_lOnBits(12)   =   CLng(8191)     
s_lOnBits(13)   =   CLng(16383)     
s_lOnBits(14)   =   CLng(32767)     
s_lOnBits(15)   =   CLng(65535)     
s_lOnBits(16)   =   CLng(131071)     
s_lOnBits(17)   =   CLng(262143)     
s_lOnBits(18)   =   CLng(524287)     
s_lOnBits(19)   =   CLng(1048575)     
s_lOnBits(20)   =   CLng(2097151)     
s_lOnBits(21)   =   CLng(4194303)     
s_lOnBits(22)   =   CLng(8388607)     
s_lOnBits(23)   =   CLng(16777215)     
s_lOnBits(24)   =   CLng(33554431)     
s_lOnBits(25)   =   CLng(67108863)     
s_lOnBits(26)   =   CLng(134217727)     
s_lOnBits(27)   =   CLng(268435455)     
s_lOnBits(28)   =   CLng(536870911)     
s_lOnBits(29)   =   CLng(1073741823)     
s_lOnBits(30)   =   CLng(2147483647)    
s_l2Power(0)   =   CLng(1)     
s_l2Power(1)   =   CLng(2)     
s_l2Power(2)   =   CLng(4)     
s_l2Power(3)   =   CLng(8)     
s_l2Power(4)   =   CLng(16)     
s_l2Power(5)   =   CLng(32)     
s_l2Power(6)   =   CLng(64)     
s_l2Power(7)   =   CLng(128)     
s_l2Power(8)   =   CLng(256)     
s_l2Power(9)   =   CLng(512)     
s_l2Power(10)   =   CLng(1024)     
s_l2Power(11)   =   CLng(2048)     
s_l2Power(12)   =   CLng(4096)     
s_l2Power(13)   =   CLng(8192)     
s_l2Power(14)   =   CLng(16384)     
s_l2Power(15)   =   CLng(32768)     
s_l2Power(16)   =   CLng(65536)     
s_l2Power(17)   =   CLng(131072)     
s_l2Power(18)   =   CLng(262144)     
s_l2Power(19)   =   CLng(524288)     
s_l2Power(20)   =   CLng(1048576)     
s_l2Power(21)   =   CLng(2097152)     
s_l2Power(22)   =   CLng(4194304)     
s_l2Power(23)   =   CLng(8388608)     
s_l2Power(24)   =   CLng(16777216)     
s_l2Power(25)   =   CLng(33554432)     
s_l2Power(26)   =   CLng(67108864)     
s_l2Power(27)   =   CLng(134217728)     
s_l2Power(28)   =   CLng(268435456)     
s_l2Power(29)   =   CLng(536870912)     
s_l2Power(30)   =   CLng(1073741824)    
s_key(0)   =   &H428A2F98     
s_key(1)   =   &H71374491     
s_key(2)   =   &HB5C0FBCF     
s_key(3)   =   &HE9B5DBA5     
s_key(4)   =   &H3956C25B     
s_key(5)   =   &H59F111F1     
s_key(6)   =   &H923F82A4     
s_key(7)   =   &HAB1C5ED5     
s_key(8)   =   &HD807AA98     
s_key(9)   =   &H12835B01     
s_key(10)   =   &H243185BE     
s_key(11)   =   &H550C7DC3     
s_key(12)   =   &H72BE5D74     
s_key(13)   =   &H80DEB1FE     
s_key(14)   =   &H9BDC06A7     
s_key(15)   =   &HC19BF174     
s_key(16)   =   &HE49B69C1     
s_key(17)   =   &HEFBE4786     
s_key(18)   =   &HFC19DC6     
s_key(19)   =   &H240CA1CC     
s_key(20)   =   &H2DE92C6F     
s_key(21)   =   &H4A7484AA     
s_key(22)   =   &H5CB0A9DC     
s_key(23)   =   &H76F988DA     
s_key(24)   =   &H983E5152     
s_key(25)   =   &HA831C66D     
s_key(26)   =   &HB00327C8     
s_key(27)   =   &HBF597FC7     
s_key(28)   =   &HC6E00BF3     
s_key(29)   =   &HD5A79147     
s_key(30)   =   &H6CA6351     
s_key(31)   =   &H14292967     
s_key(32)   =   &H27B70A85     
s_key(33)   =   &H2E1B2138     
s_key(34)   =   &H4D2C6DFC     
s_key(35)   =   &H53380D13     
s_key(36)   =   &H650A7354     
s_key(37)   =   &H766A0ABB     
s_key(38)   =   &H81C2C92E     
s_key(39)   =   &H92722C85     
s_key(40)   =   &HA2BFE8A1     
s_key(41)   =   &HA81A664B     
s_key(42)   =   &HC24B8B70     
s_key(43)   =   &HC76C51A3     
s_key(44)   =   &HD192E819     
s_key(45)   =   &HD6990624     
s_key(46)   =   &HF40E3585     
s_key(47)   =   &H106AA070     
s_key(48)   =   &H19A4C116     
s_key(49)   =   &H1E376C08     
s_key(50)   =   &H2748774C     
s_key(51)   =   &H34B0BCB5     
s_key(52)   =   &H391C0CB3     
s_key(53)   =   &H4ED8AA4A     
s_key(54)   =   &H5B9CCA4F     
s_key(55)   =   &H682E6FF3     
s_key(56)   =   &H748F82EE     
s_key(57)   =   &H78A5636F     
s_key(58)   =   &H84C87814     
s_key(59)   =   &H8CC70208     
s_key(60)   =   &H90BEFFFA     
s_key(61)   =   &HA4506CEB     
s_key(62)   =   &HBEF9A3F7     
s_key(63)   =   &HC67178F2
	End Sub
	
	'''
	Private Function lShift_(Byval p_v, Byval p_b)
		If p_b = 0 Then
			lShift_ = p_v
			Exit Function
		ElseIf p_b = 31 Then
			If p_v And 1 Then
				lShift_ = &H80000000
			Else
				lShift_ = 0
			End If
			Exit Function
		ElseIf p_b < 0 Or p_b > 31 Then
			Errc.Raise(6)
		End If
		If (p_v And s_l2Power(31 - p_b)) Then
			lShift_ = ((p_v And s_lOnBits(31 - (p_b + 1))) * s_l2Power(p_b)) Or &H80000000
		Else
			lShift_ = ((p_v And s_lOnBits(31 - p_b)) * s_l2Power(p_b))
		End If
	End Function

	'''
	Private Function rShift_(Byval p_v, Byval p_b)
		If p_b = 0 Then
			rShift_ = p_v
			Exit Function
		ElseIf p_b = 31 Then
			If p_v And &H80000000 Then
				rShift_ = 1
			Else
				rShift_ = 0
			End If
			Exit Function
		ElseIf p_b < 0 Or p_b > 31 Then
			Errc.Raise(6)
		End If
		rShift_ = (p_v And &H7FFFFFFE) \ s_l2Power(p_b)
		If (p_v And &H80000000) Then
			rShift_ = (rShift_ Or (&H40000000 \ s_l2Power(p_b - 1)))
		End If
	End Function
	
	'''
	Private Function addUnsigned_(Byval p_x, Byval p_y)
		Dim t_x4, t_y4, t_x8, t_y8, t_s
		t_x8 = p_x And &H80000000
		t_y8 = p_y And &H80000000
		t_x4 = p_x And &H40000000
		t_y4 = p_y And &H40000000
		t_s = (p_x And &H3FFFFFFF) + (p_y And &H3FFFFFFF)
		If t_x4 And t_y4 Then
			t_s = t_s Xor &H80000000 Xor t_x8 Xor t_y8
		ElseIf t_x4 Or t_y4 Then
			If t_s And &H40000000 Then
				t_s = t_s Xor &HC0000000 Xor t_x8 Xor t_y8
			Else
				t_s = t_s Xor &H40000000 Xor t_x8 Xor t_y8
			End If
		Else
			t_s = t_s Xor t_x8 Xor t_y8
		End If
		addUnsigned_ = t_s
	End Function
	
	'''
	Private Function convert2Array_(Byval p_s)
		Dim t_ml,t_wn,t_wa(),t_bp,t_bc,t_wc
		Const B_BT2BY = 8
		Const B_BY2WD = 4
		Const B_BT2WD = 32
		Const B_MDB = 512
		Const B_CRB = 448
		t_ml = LenB(p_s)
		t_wn = (((t_ml + ((B_MDB - B_CRB) \ B_BT2BY)) \ (B_MDB \ B_BT2BY)) + 1) * (B_MDB \ B_BT2WD)
		ReDim t_wa(t_wn - 1)
		t_bp = 0
		t_bc = 0
		Do Until t_bc >= t_ml
			t_wc = t_bc \ B_BY2WD
			t_bp = (t_bc Mod B_BY2WD) * B_BT2BY
			t_wa(t_wc) = t_wa(t_wc) Or lShift_(AscB(MidB(p_s, t_bc + 1, 1)), t_bp)
			t_bc = t_bc + 1
		Loop
		t_wc = t_bc \ B_BY2WD
		t_bp = (t_bc Mod B_BY2WD) * B_BT2BY
		t_wa(t_wc) = t_wa(t_wc) Or lShift_(&H80, t_bp)
		t_wa(t_wn - 2) = lShift_(t_ml, 3)
		t_wa(t_wn - 1) = rShift_(t_ml, 29)
		convert2Array_ = t_wa
	End Function
	
	'''GBK编码转成二进制流
	'p_s:GBK编码字符串
	Private Function gbk2Bin_(p_s) 
		Dim t_c,t_i,t_r,t_w,t_h
		gbk2Bin_="" 
		For t_i=1 To Len(p_s) 
			t_r = Mid(p_s,t_i,1) 
			t_c = Asc(t_r)
			If t_c<0 Then 
				t_c = t_c + 65535 
			End If
			If t_c>255 Then 
				t_w = Left(Hex(Asc(t_r)),2) 
				t_h = Right(Hex(Asc(t_r)),2) 
				gbk2Bin_ = gbk2Bin_ & ChrB("&H" & t_w) & ChrB("&H" & t_h) 
			Else
				gbk2Bin_ = gbk2Bin_ & ChrB(AscB(t_r)) 
			End If
		Next
	End Function
	
	'''UTF-8编码转成二进制流
	'p_s:UTF-8编码字符串
	Private Function utf2Bin_(p_s)
		Dim t_r, t_c, t_a, t_j, t_i
		utf2Bin_ = ""
		For t_i=1 To Len(p_s)
			t_r = Mid(p_s,t_i,1)
			t_c = Server.UrlEncode(t_r)
			If(t_c="+") Then
				t_c = "%20"
			End If
			If Len(t_c) = 1 Then
				utf2Bin_ = utf2Bin_ & ChrB(AscB(t_c))
			Else
				t_a = Split(t_c,"%")
				For t_j = 1 to UBound(t_a)
					utf2Bin_ = utf2Bin_ & ChrB("&H" & t_a(t_j))
				Next
			End If
		Next
	End Function
	
	'''
	Private Function wordToHex_(Byval p_s)
		Const B_BT2BY = 8
		Dim t_b,t_c
		For t_c = 0 To 3
			t_b = rShift_(p_s, t_c * B_BT2BY) And s_lOnBits(B_BT2BY - 1)
			wordToHex_ = wordToHex_ & Right("0" & Hex(t_b), 2)
		Next
	End Function
	
	'''
	Private Function Ch(x,   y,   z)
		Ch = ((x And y) Xor ((Not x) And z))
	End Function
	
	'''
	Private Function Maj(x,   y,   z)     
		Maj   =   ((x   And   y)   Xor   (x   And   z)   Xor   (y   And   z))     
	End Function
	
	'''
	Private   Function   S(x,   n)     
		S   =   (rShift_(x,   (n   And   s_lOnBits(4)))   Or   lShift_(x,   (32   -   (n   And   s_lOnBits(4)))))     
	End   Function    
	
	Private   Function   R(x,   n)     
		R   =   rShift_(x,   cLng(n   And   s_lOnBits(4)))     
	End   Function    

	Private   Function   Sigma0(x)     
		Sigma0   =   (S(x,   2)   Xor   S(x,   13)   Xor   S(x,   22))     
	End   Function    

	Private   Function   Sigma1(x)     
		Sigma1   =   (S(x,   6)   Xor   S(x,   11)   Xor   S(x,   25))     
	End   Function    

	Private   Function   Gamma0(x)     
		Gamma0   =   (S(x,   7)   Xor   S(x,   18)   Xor   R(x,   3))     
	End   Function    

	Private   Function   Gamma1(x)     
		Gamma1   =   (S(x,   17)   Xor   S(x,   19)   Xor   R(x,   10))     
	End   Function    

	'''
	Public Default  Function   SHA256(sMessage)    
    Dim   HASH(7)     
    Dim   M     
    Dim   W(63)     
    Dim   a     
    Dim   b     
    Dim   c     
    Dim   d     
    Dim   e     
    Dim   f     
    Dim   g     
    Dim   h     
    Dim   i     
    Dim   j     
    Dim   T1     
    Dim   T2     
      
    HASH(0)   =   &H6A09E667     
    HASH(1)   =   &HBB67AE85     
    HASH(2)   =   &H3C6EF372     
    HASH(3)   =   &HA54FF53A     
    HASH(4)   =   &H510E527F     
    HASH(5)   =   &H9B05688C     
    HASH(6)   =   &H1F83D9AB     
    HASH(7)   =   &H5BE0CD19     
    'M   =   convert2Array_(sMessage)     
	Select Case Lcase(CharSet)
	Case "utf-8"
		M = convert2Array_(utf2Bin_(sMessage))
	Case "gbk","gb2312"
		M = convert2Array_(gbk2Bin_(sMessage))
	Case Else
		M = convert2Array_(utf2Bin_(sMessage))
	End Select
    For   i   =   0   To   UBound(M)   Step   16     
        a   =   HASH(0)     
        b   =   HASH(1)     
        c   =   HASH(2)     
        d   =   HASH(3)     
        e   =   HASH(4)     
        f   =   HASH(5)     
        g   =   HASH(6)     
        h   =   HASH(7)     
        For   j   =   0   To   39  
            If   j   <   16   Then     
                W(j)   =   M(j   +   i)     
            Else     
                W(j)   =   addUnsigned_(addUnsigned_(addUnsigned_(Gamma1(W(j   -   2)),   W(j   -   7)),   Gamma0(W(j   -   15))),   W(j   -   16))     
            End   If     
            T1   =   addUnsigned_(addUnsigned_(addUnsigned_(addUnsigned_(h,   Sigma1(e)),   Ch(e,   f,   g)),   s_key(j)),   W(j))     
            T2   =   addUnsigned_(Sigma0(a),   Maj(a,   b,   c))     
            h   =   g     
            g   =   f     
            f   =   e     
            e   =   addUnsigned_(d,   T1)     
            d   =   c     
            c   =   b     
            b   =   a     
            a   =   addUnsigned_(T1,   T2)     
        Next     
        HASH(0)   =   addUnsigned_(a,   HASH(0))     
        HASH(1)   =   addUnsigned_(b,   HASH(1))     
        HASH(2)   =   addUnsigned_(c,   HASH(2))     
        HASH(3)   =   addUnsigned_(d,   HASH(3))     
        HASH(4)   =   addUnsigned_(e,   HASH(4))     
        HASH(5)   =   addUnsigned_(f,   HASH(5))     
        HASH(6)   =   addUnsigned_(g,   HASH(6))     
        HASH(7)   =   addUnsigned_(h,   HASH(7))     
    Next     
    SHA256   =   LCase(wordToHex_(HASH(0)) & wordToHex_(HASH(1)) & wordToHex_(HASH(2)) & wordToHex_(HASH(3)) & wordToHex_(HASH(4)) & wordToHex_(HASH(5)) & wordToHex_(HASH(6)) &  wordToHex_(HASH(7)))     
	End   Function 
End Class
%>